SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00017 STRING HANDLING ROUTINES 1 05-28-9313:58ALL SWAG SUPPORT TEAM ASCZ2STR.PAS IMPORT 6 Function Asc2Str(Var s; Max : Byte): String;π{ Converts an ASCIIZ String to a Turbo Pascal String }π{ With a maximum length of max. }πVarπ StArray : Array[1..255] of Char Absolute s;π Len : Integer;πbeginπ Len := Pos(#0,StArray)-1; { Get the length }π if (Len > Max) or (Len < 0) then { length exceeds maximum }π Len := Max; { so set to maximum }π Asc2Str := StArray;π Asc2Str[0] := Chr(Len); { Set length }πend; { Asc2Str }π 2 05-28-9313:58ALL SWAG SUPPORT TEAM CLEANSTR.PAS IMPORT 6 Procedure CleanString(Var s:String);πbeginπ fillChar(s,sizeof(s),0);πend;π{ I think that I already posted this form once, but here it is again...π This is the best way, For what the original poster wanted it for- toπ clear out a String to Write to a File. Method #1 above will overfillπ any subranged String, yours only clears out the current size of theπ String (ie if you had s:String; s := 'a'; then your Procedure wouldπ only fill the first Character. The last version merely fills theπ entire String no matter what the size of it is.π-Brian Papeπ} 3 05-28-9313:58ALL SWAG SUPPORT TEAM COMMA.PAS IMPORT 17 { CB> ...I work For a bank and would like to create a Program toπ CB> maintain better Record of our Cashier Checks and also anyπ CB> stop payments on them..I have done very little Programmingπ CB> on pascal. Ok here goes:π CB> I would like to make the input of numbers to moveπ CB> from a fixed point to the left and insert commasπ CB> every three digits For monetary figures?ππYou will need to set up a dedicated Character by Character input routine usingπReadKey and controlling the display yourself. After each Character is enteredπexamine it and determine whether or not to add a comma. The following veryπsimple (and untested) routine demonstrates this.ππFor a better way to do such input find and download TCSEL003.* from a PDN nodeπnear you and study the KEYINPUT Unit. You may be able to modify it to doπexactly what you want or perhaps use it as a guide to producing your ownπ"bullet proof" input routine.π}πUsesπ Crt;ππFunction LastPos(ch : Char; S : String): Byte;π { Returns the last position of ch in S or zero if ch not in S }π Varπ x : Word;π len : Byte Absolute S;π beginπ x := succ(len);π Repeatπ dec(x);π Until (x = 0) or (S[x] = ch);π LastPos := x;π end; { LastPos }πππProcedure GetNumber(fieldwidth: Byte);π Var ch : Char;π x,y: Byte;π i : Word;π st : String;π beginπ st := '';π Write('Enter a number: ');π x := WhereX;π y := WhereY;π Repeatπ ch := ReadKey;π Case ch ofπ '0'..'9': beginπ if LastPos(',',st) = length(st)-3 thenπ st := st + ',';π st := st + ch;π end;π #8 : beginπ delete(st,length(st),1);π if st[length(st)] = ',' thenπ delete(st,length(st),1);π end;π #13 : Exit;π end;π gotoXY(x,y);π Write(st:fieldwidth);π Until False;π end;ππbeginπ Writeln;π Writeln;π getnumber(14);πend. 4 05-28-9313:58ALL SWAG SUPPORT TEAM FIND-STR.PAS IMPORT 5 Function FirstOccurence(s : String;π c : Char) : Integer; Assembler;πAsmπ CLDπ LES DI, sπ xor CH, CHπ xor AH, AHπ MOV CL, ES:[DI]π JCXZ @1π MOV BX, CXπ inC DIπ MOV AL, cπ REPNE SCASBπ JCXZ @1π SUB BX, CXπ XCHG AX, BXπ JMP @2π@1:π xor AX, AXπ@2:πend;ππbegin { This example returns 7 }π WriteLn(FirstOccurence('smullen met de pet op dat is pas je ware', 'n'));πend.π 5 05-28-9313:58ALL SWAG SUPPORT TEAM PERM-STR.PAS IMPORT 10 {ππHere it is. note that this permutes a set of Characters. if you want toπdo something different, you will have to modify the code, but that shouldπbe easy.ππ}ππTypeπ tThingRec = Recordπ ch : Char;π occ : Boolean;π end;ππVarπ Thing : Array[1..255] of tThingRec;π EntryString : String;ππProcedure Permute(num : Byte);π{ N.B. Procedure _must_ be called With num = 1;π it then calls itself recursively,π incrementing num }πVarπ i : Byte;πbeginπ if num > length(EntryString) thenπ beginπ num := 1;π For i := 1 to length(EntryString) doπ Write(Thing[i].Ch); { You'll want to direct }π Writeln; { output somewhere else }π endπ elseπ beginπ For i := 1 to length(EntryString) doπ beginπ if (not Thing[i].Occ) thenπ beginπ Thing[i].Occ := True;π Thing[i].Ch := EntryString[num];π Permute(succ(num));π Thing[i].Occ := False;π end;π end;π end;πend;πππbeginπ FillChar(Thing,sizeof(Thing),0);π Write('Enter String of Characters to Permute: ');π Readln(EntryString);π Permute(1);π Writeln;π Writeln('Done');πend.π 6 05-28-9313:58ALL SWAG SUPPORT TEAM SPACES.PAS IMPORT 6 Function Spaces(NumSpaces : Byte) : String;ππVarπ s : String;ππbeginπ s[0] := Chr(Numspaces);π If NumSpaces = 0 Thenπ Exit;π FillChar(s[1], NumSpaces, ' ');π Spaces := s;πend;ππ{πThis still too slow For my taste, though... there's a superfluous Stringπcopy and it still needs 512 Bytes of stack space.π}ππFunction Spaces(NumSpaces : Byte) : String; Assembler;ππAsmπ LES DI, @Resultπ CLDπ MOV AL, NumSpacesπ xor AH, AHπ STOSBπ XCHG AX, CXπ JCXZ @Exitπ MOV AL, ' 'π SHR CX, 1π JNC @Evenπ STOSBπ@Even: REP STOSWπ@Exit:πend; { Spaces }π 7 05-28-9313:58ALL SWAG SUPPORT TEAM ST-CASE1.PAS IMPORT 9 today class we are looking at some String routines. Routines toπconvert Strings to upper Case, lower Case,etc.ππRemember to turn off CHECK String Var PARAMETER LENGTHS With {$V-}πbeFore calling the String Procedures. Turn it back on after callingπthis proc.ππ{--[UPPER CASinG StringS]--}ππProcedure UPCaseL(Var CString:String);ππVar I:Byte;ππ beginπ For I:=1 to LENGTH(CString) do CString[I]:=UPCase(CString[I])π end;ππ{--[LOWER CASinG CharS]--}ππFunction DWNCase(DWNCH:Char):Char;ππbeginπif ('A' <= DWNCH) and (DWNCH <= 'z') then DWNCase:=CHR(orD(DWNCH)+32)πend;ππ{--[LOWER CASinG StringS]--}ππProcedure DWNCaseL(Var CString:String);ππVar I:Byte;ππbeginπ For I:=1 to LENGTH(CString) do CString[I]:=DWNCase(CString[I])πend;ππ--------------πif you are offended at the subject line, then please don't read theπmessage. if you think that I, TL, am calling you an idiot because myπsubject line said IDIOT PASCAL LESSONS and you read this message...πwell, hey, I'm not.π-------------π 8 05-28-9313:58ALL SWAG SUPPORT TEAM ST-CASE2.PAS IMPORT 3 Function DnCase(Ch: Char): Char;πVarπ n : Byte Absolute ch;πbeginπ Case ch ofπ 'A'..'Z': n := n or 32;π end;π DnCase := chr(n);πend;π 9 05-28-9313:58ALL SWAG SUPPORT TEAM ST-CASE3.PAS IMPORT 21 {πHere's a few routines you might find useful For your name problem.πI call the Function "UpperName" whenever the user presses aπvalid Text key in a name field, but it can also be called justπonce after the entire input String is entered.π}ππ(* First, some general routines: *)π(* ----------------------------- *)ππFunction FindStrLength(S: String): Byte;π{ Finds "S"'s length, not counting trailing spaces }πVarπ StrLen: Byte Absolute S;π I : Byte;ππbeginπ I := StrLen;π if StrLen > 0 thenπ For I := StrLen downto 0 doπ if S[I] <> ' ' thenπ Break;π FindStrLength := I;πend; { FindStrLength }ππFunction WordDelimiter(C: Char): Boolean;π{ -Checks if "C" qualifies as a String Word-delimiter }πConstπ WordDels: Array[1..34] of Char =π #32#9#13#10#39',./?;:"<>[]{}-=\+|()*%@&^$#!~';πVarπ I: Integer;ππbeginπ WordDelimiter := False;π For I := 1 to 34 doπ if C = WordDels[I] thenπ beginπ WordDelimiter := True;π Break;π end;πend; { WordDelimiter }ππFunction ParceWord(S: String; Ind, L: Integer): String;π{ Returns the next Word from "Ind" index in "S" }πVarπ I: Integer;ππbeginπ ParceWord := '';π I := Ind;π For I := Ind to L doπ if WordDelimiter(S[I+1]) thenπ beginπ ParceWord := Copy(S, Ind, I-Ind+1);π Break;π end;πend; { ParceWord }πππ(* Now down to business: *)π(* --------------------- *)ππProcedure UpperName(Var S: String);π{ Converts the first Character in Words to upper Case letters }πVarπ I, L: Integer;π St : String;ππbeginπ L := FindStrLength(S);π if L = 0 thenπ Exit;π For I := L downto 2 doπ if WordDelimiter(S[I-1]) thenπ beginπ St := StUpCase(ParceWord(S, I, L));π { you can put in exception Words here... }π if (St = 'DE') or (St = 'DEN') thenπ { ie: Markis de Bleuchamp or van den Haag }π S[I] := 'd'π elseπ S[I] := UpCase(S[I]);π end;π S[1] := UpCase(S[1]);πend; { UpperName }ππ{π(The Function "StupCase" is from TurboPower Tpro, but anyπroutine that converts a String to upper Case letters will do).ππPlease note that I had to modify this source beForeπposting it here (it was full of norwegian name styleπidentifiers that only would've confused you), so it's notπtested in the current Form and may contain bugs.π...But I'm sure you get the general idea. :-)ππposting it here (it was full of norwegian name styleπidentifiers that only would've confused you), so it's notπtested in the current Form and may contain bugs.π...But I'm sure you get the general idea. :-)π} 10 05-28-9313:58ALL SWAG SUPPORT TEAM ST-CASE4.PAS IMPORT 41 { Many will recall a series of messages that I posted a few weeksπ ago regarding the Implementation of XLAT in BAsm.ππ I have revisited it With the idea of using it not For filteringπ but just For up- and low-casing Pascal Strings. I came With aπ pure Assembler Function With a loop of only 4 instructions (TXlatπ in Unit TXLATU.PAS). The acCompanying Program TXLATE1.PAS showsπ examples on how to use TXlat both For up- or low-casing a String.ππ The intriguing finding was that when I bench-marked it againstπ other Assembler Upcasing routines posted in this echo or againstπ the one in Hax 144 in PC-Techniques (Vol.3, No.6, Feb 1993, p.40)π TXlat got to be 20-30% faster! if anyone is interested I couldπ upload the benchmarking routines.ππ So, here is my question: could this possibly be the fastestπ routine For String conversion in Turbo Pascal?ππ Please note that XLAT has special requirements respect to theπ location of the source and destination buffers as well as theπ translation table. Turbo Pascal memory model places globalπ Variables in the data segment wh local Variables are located inπ the stack segment. The code in TXlat requires that both the tableπ and the source buffer be located in the data segment.ππ Another point of interest is that a Pascal String Variabe (Table) isπ used as the 256-Byte long table required by XLAT.ππ -Jose- (1:163/513.3)ππ ============================================================================ππ}π Unit TXLATU;ππ {┌───────────────────────────────────────────┐}π {│Unit TXlatU.PAS by José Campione, Feb.1993.│}π {│This Unit implements Function TXlat and │}π {│declares Variables in the data segment. │}π {└───────────────────────────────────────────┘}ππ Interfaceππ Varπ Source, Table : String; {┌───────────────────────────────────┐}π {│This Forces these Variables to be │}π {│in the data segment. Both Variables│}π {│passed to TXlat must be created in │}π {│this segment. │}π {└───────────────────────────────────┘}ππ Function TXlat(Var Source: String; Var Table: String):String;ππ Implementationππ {┌───────────────────────────────────────────────────────────────────┐}π {│This Function translates or filters a String as per the Byte values│}π {│in the Table buffer. It implements the Assembler XLAT instruction. │}π {└───────────────────────────────────────────────────────────────────┘}π Function TXlat(Var Source: String; Var Table: String):String; Assembler;π Asmπ push ds {preserve data segment}π lds bx,table {load ds:bx With table address}π lds si,source {load ds:si With source address}π {both are in datasegment...}π les di,@result {load es:di With result}π cld {si will increment}π lodsb {load al With length of source}π stosb {store al in es:di}π mov cx,ax {assign length of source to counter}π or cx,cx {if counter = 0}π jz @end {jump to end}π @filter: lodsb {load Byte in ax}π xlat {tans-xlat-e...}π stosb {store it in destination Array}π loop @filter {loop back}π @end: pop ds {restore data segment}π end;ππ end.π{π ---------------------------------------------------------------------π}π Program TXLATE1;ππ {┌───────────────────────────────────────────────┐}π {│Program TXlate1.PAS by José Campione, Feb.1993.│}π {│Test Program For Function TXlat in Unit TXlatU │}π {│It shows how the same Function can be used For │}π {│up-casing of low-casing a String. │}π {└───────────────────────────────────────────────┘}ππ Uses TXLATU, HAX144U;ππ Varπ UpSource, LowTable, {These must be global Variables}π LowSource, UpTable : String; {created in the data segment }π i : Byte;ππ beginππ {┌────────────────────────────────────────────┐}π {│Set Table For upper Case translation by XLAT│}π {└────────────────────────────────────────────┘}π For i:= 0 to 255 doπ if i in [$61..$7A] then UpTable[i]:= Char(i - $20)π else UpTable[i]:= Char(i);ππ {┌────────────────────────────────────────────┐}π {│Set Table For lower Case translation by XLAT│}π {└────────────────────────────────────────────┘}π For i:= 0 to 255 doπ if i in [$41..$5A] then LowTable[i]:= Char(i + $20)π else LowTable[i]:= Char(i);ππ LowSource:= 'this is a low-Case String to be up-Cased';π UpSource:= 'THIS IS AN UP-Case String to BE LOW-CaseD';ππ Writeln(TXlat(LowSource,UpTable));π Writeln(TXlat(UpSource,LowTable));ππ ReadLn;ππ end.π 11 05-28-9313:58ALL SWAG SUPPORT TEAM ST-CASE5.PAS IMPORT 27 {π> For some routins you may have.. Stuff like converting a String toπ> upperCase, padding a String, and things like that.. Mainly stuff to doπ> With Strings, as that seems to be my problem.. if you could, pleaseπ> document your source so i can see how it is done.πππ1)The Good Old String UpCase Routine. I'm sure there are at leastπ several thousand Programmers, who have independently come up With codeπ exactly like this:π}ππProcedure StrUpr(Var S: String); Assembler;πAsmπ push ds { Save DS on stack }π lds si, S { Load DS:SI With Pointer to S }π cld { Clear direction flag - String instr. Forwardπ lodsb { Load first Byte of S (String length Byte) }π sub ah, ah { Clear high Byte of AX }π mov cx, ax { Move AX in CX }π jcxz @Done { Length = 0, done }π mov ax, ds { Set ES to the value in DS through AX }π mov es, ax { (can't move between two segment Registers) }π mov di, si { DI and SI now point to the first Char. }π@UpCase:π lodsb { Load Character }π cmp al, 'a'π jb @notLower { below 'a' -- store as is }π cmp al, 'z'π ja @notLower { above 'z' -- store as is }π sub al, ('a' - 'A') { convert Character in AL to upper Case }π@notLower:π stosb { Store upCased Character in String }π loop @UpCase { Decrement CX, jump if not zero }π@Done:π pop ds { Restore DS from stack }πend;ππ{π2)Right justify routine. if Length(S) < Width then S will beπ padded With spaces on the left.π}ππProcedure RightJustify(Var S: String; Width: Byte); Assembler;πAsmπ push ds { Save DS }π lds si, S { Load Pointer to String }π mov al, [si] { Move length Byte in AL }π mov ah, Width { Move Width in AH }π sub ah, al { Subtract }π jbe @Done { if Length(S) >= Width then Done... }π push si { Save SI on stack }π mov cl, alπ sub ch, ch { CX = length of the String }π add si, cx { SI points to the last Character }π mov dx, dsπ mov es, dx { ES = DS }π mov di, si { DI = SI }π mov dl, ahπ sub dh, dh { DX = number of spaces to padd }π add di, dx { DI points to the new end of the String }π std { String ops backward }π rep movsb { Copy String to the new location }π pop si { SI points to S }π mov di, si { DI points to S }π add al, ah { AL = new length Byte }π cld { String ops Forward }π stosb { Store new length Byte }π mov al, ' 'π mov cx, dx { CX = number of spaces }π rep stosb { store spaces }π@Done:π pop ds { Restore DS }πend;ππ{π I wrote both examples specifically For posting in thisπconference (my regular code is For external Assembler and nowhere Nearlyπas well commented). Both Functions appear to work as advertised andπshould be very fast.π}ππ 12 05-28-9313:58ALL SWAG SUPPORT TEAM ST-CASE6.PAS IMPORT 17 {πNORBERT IGLππ> Note that your uppercase characters do not include the german Umlautsπ> and overlap sometimes with other foreign characters. There is a DOSπ> function call to convert a string to all upcercase letters. Norbertπ> Igl and I wrote a ASM end implementation, maybe he could repost his all-π> Pascal version that conforms to the DOS country information.ππ}ππUnit Upper;π{ Country-independent upcase-procedures (c) 1992 N.Iglππ Uses the COUNRY=??? from your CONFIG.SYS to get the correct uppercase.π SpeedUp with a table-driven version to avoid multiple DOS-Calls.ππ Released to the public domain ( FIDO: PASCAL int'l ) in 12/92 }πππInterfaceππfunction UpCase(ch : char) : Char;πfunction UpCaseStr(S : String) : String;ππImplementation uses Dos;ππConstπ isTableOk : Boolean = FALSE;πVarπ theTable : Array[0..255] of Char;ππProcedure SetUpTable; { called only at Unit-init }πvarπ Regs: Registers;π x : byte;πbeginπ FillChar(theTable, Sizeof( theTable ), #0); { Fill with NULL }π For x := 1 to 255 doπ theTable[x] := CHAR(x); { predefined values }π if Lo(DosVersion) < 4 then { n/a in this DOS... }π begin { use Turbo's Upcase }π for x := 1 to 255 doπ theTable[x] := System.Upcase(CHAR(x));π exit;π end;π Regs.AX := $6521; { "Capitalize String" }π Regs.CX := 255; { "string"-length }π Regs.DS := Seg(theTable); { DS:DX... }π Regs.DX := Ofs(theTable[1]); { ...points to the "string"}π Intr($21,Regs); { let DOS do it ! }π isTableOK := (Regs.Flags and FCarry = 0); { OK ? }πend;ππfunction UpCase(ch : char) : char;πbeginπ UpCase := theTable[BYTE(ch)]πend;ππfunction UpCaseStr(S : String) : String;πvar x: Byte;πbeginπ for x := 1 to length(S) doπ S[x]:= theTable[BYTE(S[x])];π UpCaseStr := Sπend;ππbeginπ SetUpTableπend.ππ 13 05-28-9313:58ALL SWAG SUPPORT TEAM STR-INFO.PAS IMPORT 17 {πFunctions returning Strings are generally space wasters. For example,πsuppose you have :ππFunction UpCaseStr(s : String) : String;ππif you're implementing it in plain Pascal, you'll need 1024 Bytes of dataπat a minimum:π- 256 Bytes are allocated For "s", the Formal parameterπ- 256 Bytes For a local copy of "s" since it was passed as a value parameterπ- 256 Bytes For a local Variable of the Type String, working storage to buildπ the Function resultπ- 256 Bytes For assigning the result to the Function resultπ (as in: "UpCaseStr := Result").ππYou can cut this figure by 50% by taking the following steps:π- (Version 7) Change the parameter header intoπ "Function UpCaseStr(Const s : String) : String". Provided you don'tπ change "s", no local copy of the String will be created.π- (Version 6) Implement the routine in Assembler. Requires knowledge ofπ Asm, of course - but it generally will do away With the need of allocatingπ 256 Bytes of working storage.ππNow you have reduced data space to 512 Bytes: it has become a basicπinput-output Function. One question remains: it is necessary to load theπString to examine the result of such a Function. Suppose we want to figure outπwhether the user has entered a switch on the command line: do we need aπVariable of the Type String to acComplish this? You don't. The followingπsnippet of code will show how: using a 2 Bytes macro, we'll convert a Stringπinto a Pointer to a String. You only have to dereference the Pointer to getπthe result - and save 256 Bytes of data space in the process.π}ππTypeπ PString = ^String;ππFunction StrPtr(Const s : String) : PString;ππInLine(π $58/ { POP AX }π $5A); { POP DX }ππVarπ i : Integer;π sp : PString;π QuietFlag : Boolean;ππbeginπ For i := 1 to ParamCount Doπ beginπ sp := StrPtr(ParamStr(i));π if (sp^[1] in ['/', '-']) and (UpCase(sp^[2]) = 'Q') thenπ QuietFlag := True;π { Et cetera }π end;πend.π 14 05-28-9313:58ALL SWAG SUPPORT TEAM STRNGSF4.PAS IMPORT 24 {πThis code has been slightly shrunk to fit into one message.π}ππProgram input;πUsesπ Dos, Crt;ππConstπ Word_wrap = 50;ππVarπ tick,π mlines : Integer;π modem : String[1];π incom,π waiting : String[128];ππProcedure outread(avr1, avr2, avr3 : Integer);ππVar { avr1= 1=passWord, 2=normal }π i,y,o, { avr2= 1=none, 2=Word wrap }π count:Integer; { avr3= 1=pull from String, 2=none }π Word:String[10]; Charout:Char;ππbeginπ incom:=''; count:=0; mlines:=0;π if avr3=2 then waiting:='';π if avr3=1 then if waiting<>'' thenπ beginπ incom:=waiting;π waiting:='';π Write(incom);π count:=length(incom);π end;π modem:=''; TextColor(3);π While modem<>chr(13) doπ beginπ Charout:=ReadKey; modem:=Charout;π Case ord(modem[1]) ofπ 13:begin { return }π Writeln; Exit;π end;π 8:begin { backspace }π if count>0 thenπ beginπ Write(chr(8)+chr(32)+chr(8));π delete(incom,count,1);π count:=count-1;π end;π modem:='';π end;π 9:begin { tab }π Write(' '); incom:=incom+' '; count:=count+5;π modem:='';π end;π 10:modem:=''; { line feed }π 1..26,π 28..31,π 128..255:begin { inappropriate Characters }π modem:='';π end;π end;π if modem<>'' thenπ beginπ count:=count+1;π if count<Word_wrap thenπ beginπ incom:=incom+modem;π Case avr1 ofπ 1:Write('?');π 5:Write;π else Write(modem);π end;π end else if avr2=2 thenπ beginπ waiting:='';π For i:=length(incom) DownTo 1 doπ beginπ Write(chr(8)+chr(32)+chr(8));π Word:=copy(incom,i,1);π if Word=chr(32) thenπ beginπ waiting:=copy(incom,i+1,length(incom));π waiting:=waiting+modem;π delete(incom,i,length(incom)); Writeln; Exit;π end;π end;π end;π end;π end; { waiting For modem to = chr(13) }π if avr1 <> 5 then Writeln;πend; { end of Procedure }ππbeginπ ClrScr;π TextColor(15);π Write('This is a passWord input: ');π outread(1,1,2);π TextColor(11);π Writeln('Return = ',incom);π TextColor(15);π Write('This is a normal input: ');π outread(2,1,2);π TextColor(11);π Writeln('Return = ',incom);π TextColor(15);π Writeln('This is a controlled Word-wrap input at length 50:');π Writeln;π tick := 0;π For tick := 1 to 5 doπ outread(2, 2, 1);πend.π 15 05-28-9313:58ALL SWAG SUPPORT TEAM TIDYSTR.PAS IMPORT 4 {πKELD R. HANSENπ}ππPROCEDURE TidyString(VAR Str : String); ASSEMBLER;πASMπ LES DI,STRπ XOR BH,BHπ MOV BL,ES:[DI]π LEA DI,[DI+BX+1]π MOV SI,WORD PTR STR-2π NEG BXπ LEA CX,[SI+BX]π XOR AL,ALπ CLDπ REP STOSBπEND;ππ{πwhich fills up the garbage after the current string length with zeroes.π}ππ 16 05-28-9313:58ALL SWAG SUPPORT TEAM WILDCRD1.PAS IMPORT 14 Program wild_card;ππVarπ check:Boolean;ππFunction Wild(flname,card:String):Boolean;π{Returns True if the wildcard description in 'card' matches 'flname'πaccording to Dos wildcard principles. The 'card' String MUST have a period!πExample: Wild('test.tat','t*.t?t' returns True}ππVarπ name,temp:String[12];π c:Char;π p,i,n,l:Byte;π period:Boolean;ππbeginπ wild:=True;π {test For special Case first}π if flname='*.*' then Exit;π wild:=False;π p:=pos('.',card);π i:=pos('.',flname);π if p > 0 then period:=True else Exit; {not a valid wildcard if no period}π N:=1;π Repeatπ if card[n]='*' then n:=p-1 elseπ if (upCase(flname[n]) <> upCase(card[n])) thenπ if card[n]<>'?' then Exit;π inc(n);π Until n>=p;π n:=p+1; {one position past the period of the wild card}π l:=length(flname);π inc(i); {one position past the period of the Filename}π Repeatπ if n > length(card) then Exit;π c:=upCase(card[n]);π if c='*' then i:=l+1 {in order to end the loop}π elseπ if (upCase(flname[i]) = c) or (c = '?') thenπ beginπ inc(n);π inc(i);π endπ else Exit;π Until i > l;ππ wild:=True;ππend;ππbeginπ check:=False;π check:=wild('TEST.Tat','T*.T?T'); {True}π Writeln(check);π check:=wild('TEST.Taq','T*.T?T'); {False}π Writeln(check);π check:=wild('12345678.pkt','*.pkt'); {True}π Writeln(check);π check:=wild('test.tat','T*.t?'); {False}π Writeln(check);π check:=wild('12345678.pkt','1234?678.*'); {True}π Writeln(check);ππend. 17 05-28-9313:58ALL SWAG SUPPORT TEAM WILDCRD2.PAS IMPORT 14 {π> Does anyone know how to pass a wildcard Filename to a parameter String andπ> have the code grab the actual full Filename?ππnot quite, but close. Consider the Function Wild below. if you should do aπfindfirst/findnext and run the Function wild on each found name you get whatπyou want.π}ππFunction Wild(FileName, Card : String) : Boolean;π{Returns True if the wildcard description in 'card' matches 'flname'πaccording to Dos wildcard principles. The 'card' String MUST have a period!πExample: Wild('test.tat','t*.t?t' returns True}πVarπ c : Char;π p,i,n,l : Byte;ππbeginπ Wild := True;π {test For special Case first}π if Card = '*.*' thenπ Exit;π Wild := False;π p := Pos('.', Card);π i := Pos('.', FileName);π if p = 0 thenπ beginπ Writeln('Invalid use of Function "wild". Program halted.');π Writeln('Wild card must contain a period.');π Halt;π end;π {test the situation beFore the period}π n := 1;π Repeatπ c := UpCase(Card[n]);π if c = '*' thenπ n := pπ elseπ if (upCase(FileName[n]) = c) or (c = '?') thenπ inc(n)π elseπ Exit;π Until n >= p;ππ {Now check after the period}π n := p + 1; {one position past the period of the wild card}π l := Length(FileName);π Inc(i); {one position past the period of the Filename}π Repeatπ if n > Length(Card) thenπ Exit;π c := UpCase(Card[n]);π if c = '*' thenπ i := l + 1 {in order to end the loop}π elseπ if (UpCase(FileName[i]) = c) or (c = '?') thenπ beginπ Inc(n);π Inc(i);π endπ elseπ Exit;π Until i > l;ππ Wild := True;πEnd;
